perm filename WINGS[G,BGB]1 blob
sn#020192 filedate 1973-01-14 generic text, type T, neo UTF8
00100 TITLE WINGS - THE WINGED EDGE SUBROUTINES - JULY 1972.
00200 COMMENT / - MODIFIED FOR GEOMED - 13 JANUARY 1973.
00300
00400 1. BFEV MAKE & KILL OPERATIONS........................4 & 5.
00500 BNEW ← MKB(B); KLB(BNEW);
00600 FNEW ← MKF(B); KLF(B,FNEW);
00700 ENEW ← MKE(B); KLE(B,ENEW);
00800 VNEW ← MKV(B); KLV(B,VNEW);
00900 BNEW ← MKBFV; KLBFEV(Q);
01000
01100 2. WING MAKE LINK OPERATIONS..............................6.
01200 WING(E1,E2);
01300 LINKED(Q1,Q2);
01400
01500 3. ORIENTED WING FETCH & STORE OPERATIONS.............7 & 8.
01600 E ← ELEFT(V,F); E ← ERIGHT(V,F);
01700 E ← ECW(E,Q); E ← ECCW(E,Q);
01800 Q ← OTHER(E,Q); OTHER.(A,E,Q);
01900
02000 4. BFV FETCH OPERATIONS..............................9 & 10.
02100 B ← BODY(Q);
02200 F ← FCW(E,V); F ← FCCW(E,V);
02300 V ← VCW(E,F); V ← VCCW(E,F);
02400 /
02500
02600 INTERN WORLD↔WORLD: 0
02700 INTERN BTOTAL,FTOTAL,ETOTAL,VTOTAL
02800 DECLARE{BTOTAL,FTOTAL,ETOTAL,VTOTAL}
02900 EXTERN KILL,MAKE
00100 SUBR(MKB) → BNEW.-------------------------------------------------
00200 BEGIN MKB
00300 AOS BTOTAL↔CALL(MAKE,{[BBIT]}) ;CREATE NODE.
00400 DIP 1,1↔DAC 1,1(1)↔DAC 1,2(1)↔DAC 1,3(1) ;FEV - RINGS.
00500 LAC 3,WORLD↔CW 2,3 ;GET WORLD.
00600 CW. 1,3↔CCW. 3,1↔CCW. 1,2↔CW. 2,1 ;WORLD RINGIN.
00700 CDR 1,1↔POP0J ;RETURN BNEW.
00800 BEND;1/14/73------------------------------------------------------
00900
01000 SUBR(MKBFV) → BNEW.-----------------------------------------------
01100 BEGIN MKBFV
01200 SETQ(BNEW,{MKB}) ;BODY.
01300 CALL(MKF,BNEW) ;FACE.
01400 CALL(MKV,BNEW) ;VERTEX.
01500 LAC 1,BNEW↔POP0J ;RETURN BNEW.
01600 BNEW:0
01700 BEND;1/14/73------------------------------------------------------
00100 SUBR(MKF) → FNEW.-------------------------------------------------
00200 BEGIN MKF
00300 Q←1 ↔ X←2 ↔ B←3
00400 AOS FTOTAL↔CALL(MAKE,{[FBIT]}) ;FACE NODE.
00500 PUSH P,X↔PUSH P,B
00600 LAC B,ARG3↔NFACE X,B↔PFACE. Q,X
00700 NFACE. Q,B↔PFACE. B,Q↔NFACE. X,Q ;RINGIN.
00800 POP P,B↔POP P,X↔POP1J
00900 BEND;1/13/73------------------------------------------------------
01000
01100 SUBR(MKE) → ENEW.-------------------------------------------------
01200 BEGIN MKE
01300 Q←1 ↔ X←2 ↔ B←3
01400 AOS ETOTAL↔CALL(MAKE,{[EBIT]}) ;EDGE NODE.
01500 PUSH P,X↔PUSH P,B
01600 LAC B,ARG3↔NED X,B↔PED. Q,X
01700 NED. Q,B↔PED. B,Q↔NED. X,Q ;RINGIN.
01800 PBODY. B,Q
01900 POP P,B↔POP P,X↔POP1J
02000 BEND;1/14/73------------------------------------------------------
02100
02200 SUBR(MKV) → VNEW.-------------------------------------------------
02300 BEGIN MKV
02400 Q←1 ↔ X←2 ↔ B←3
02500 AOS VTOTAL↔CALL(MAKE,{[VBIT]}) ;VERTEX NODE.
02600 PUSH P,X↔PUSH P,B
02700 LAC B,ARG3↔NVT X,B↔PVT. Q,X
02800 NVT. Q,B↔PVT. B,Q↔NVT. X,Q ;RINGIN.
02900 POP P,B↔POP P,X↔POP1J
03000 BEND;1/13/73------------------------------------------------------
00100 ;KLB(BNEW).
00200 SUBR(KLB)---------------------------------------------------------
00300 BEGIN KLB
00400 B←1 ↔ X←2 ↔ Y←3
00500 LAC B,ARG1
00600 NBODY X,B↔PBODY Y,B ;DELETE FROM ALBODY RING.
00700 NBODY. X,Y↔PBODY. Y,X
00800 SUBI B,3↔DIPZ (B) ;RELEASE BODY BLK.
00900 CALL KILL,B
01000 SOS BTOTAL↔POP1J
01100 BEND;1/13/73------------------------------------------------------
01200
01300 ;KLBFEV(Q).
01400 SUBR(KLBFEV)------------------------------------------------------
01500 BEGIN KLBFEV
01600 ACCUMULATORS{B,F,E,V}
01700 LAC B,ARG1
01800 SETQ(B,{BODY,B})
01900 L1: PFACE F,B↔TESTZ F,FBIT↔GO[CALL KLF,B,F↔GO L1]
02000 L2: PED E,B↔TESTZ E,EBIT↔GO[CALL KLE,B,E↔GO L2]
02100 L3: PVT V,B↔TESTZ V,VBIT↔GO[CALL KLV,B,V↔GO L3]
02200 CALL KLB,B
02300 POP1J
02400 BEND;1/13/73------------------------------------------------------
00100 ;FACE, EDGE & VERTEX KILL PRIMITIVES.
00200
00300 ;KLF(B,FNEW).
00400 SUBR(KLF)---------------------------------------------------------
00500 BEGIN KLF
00600 X←2 ↔ Y←B←3
00700 SAVAC(6)↔LAC 1,ARG1
00800 NFACE X,1↔PFACE Y,1 ;DELETE FROM FACE RING.
00900 NFACE. X,Y↔PFACE. Y,X
01000 CALL KILL,1
01100 SOS FTOTAL ;DECREMENT THE COUNTERS.
01200 GETAC(6)↔POP2J
01300 BEND;1/13/73------------------------------------------------------
01400
01500 ;KLE(B,ENEW).
01600 SUBR(KLE)---------------------------------------------------------
01700 BEGIN KLE
01800 X←2 ↔ Y←B←3
01900 SAVAC(6)↔LAC 1,ARG1
02000 NED X,1↔PED Y,1 ;DELETE FROM EDGE RING.
02100 NED. X,Y↔PED. Y,X↔ALT 6,1
02200 SUBI 1,3↔DIPZ (1) ;RELEASE EDGE BLK.
02300 CALL KILL,1
02400 SOS ETOTAL ;DECREMENT THE COUNTERS.
02500 JUMPE 6,L
02600 CALL KILL,6
02700 L: GETAC(6)
02800 POP2J
02900 BEND;1/13/73------------------------------------------------------
03000
03100 ;KLV(B,VNEW).
03200 SUBR(KLV)---------------------------------------------------------
03300 BEGIN KLV
03400 X←2 ↔ Y←B←3
03500 SAVAC(6)↔LAC 1,ARG1
03600 NVT X,1↔PVT Y,1 ;DELETE FROM VERTEX RING.
03700 NVT. X,Y↔PVT. Y,X
03800 CALL(KILL,1)
03900 SOS VTOTAL ;DECREMENT THE COUNTERS.
04000 GETAC(6)↔POP2J
04100 BEND;1/13/73------------------------------------------------------
00100 ;WING(E1,E2) place wing pointers between two edges.
00200 ; THE AC-0 CONTROL BITS:
00300 ; [0-NV2-NV1] [0-PV2-PV1] [0-NF2-NF1] [0-PF2-PF1]
00400 SUBR(WING)--------------------------------------------------------
00500 BEGIN WING
00600 E1←3 ↔ E2←4
00700 SAVAC(4)↔SETZ↔CDR E1,ARG2↔CDR E2,ARG1
00800
00900 ;FIND THE COMMON VERTEX.
01000 ; AC-1 ← (NV1,,PV1) ⊗ (NV2,,PV2) NN,,PP in common.
01100 ; AC-2 ← (PV1,,NV1) ⊗ (NV2,,PV2) PN,,NP in common.
01200 LAC 1,3(E1)↔MOVS 2,1↔XOR 1,3(E2)↔XOR 2,3(E2)
01300 TLNN 1,-1↔TRO 3000↔TRNN 1,-1↔TRO 0300
01400 TLNN 2,-1↔TRO 2100↔TRNN 2,-1↔TRO 1200
01500
01600 ;FIND THE COMMON FACE.
01700 LAC 1,1(E1)↔MOVS 2,1↔XOR 1,1(E2)↔XOR 2,1(E2)
01800 TLNN 1,-1↔TRO 0030↔TRNN 1,-1↔TRO 0003
01900 TLNN 2,-1↔TRO 0021↔TRNN 2,-1↔TRO 0012
02000
02100 ;STORE THE WINGS AS INDICATED.
02200 SETCA
02300 TRNN 2020↔NCW.. E1,E2↔TRNN 1010↔NCW.. E2,E1
02400 TRNN 2002↔PCCW.. E1,E2↔TRNN 1001↔PCCW.. E2,E1
02500 TRNN 0220↔NCCW.. E1,E2↔TRNN 0110↔NCCW.. E2,E1
02600 TRNN 0202↔PCW.. E1,E2↔TRNN 0101↔PCW.. E2,E1
02700 GETAC(4)↔POP2J
02800 BEND;1/13/73------------------------------------------------------
00100 ;LINKED(Q1,Q2) - DETERMINE WHETHER TWO FEV ENTITIES ARE LINKED.
00200 SUBR(LINKED)------------------------------------------------------
00300 BEGIN LINKED
00400 ACCUMULATORS{Q1,Q2,E}
00500 CDR Q1,ARG2↔CDR Q2,ARG1
00600 ;BRANCH ON THE COMBINATION OF ARGUMENT TYPES.
00700 TESTZ Q2,FBIT↔EXCH Q1,Q2
00800 TEST Q1,FBIT↔GO L1 ;POTENTIAL FACE NOW IN Q1.
00900 TESTZ Q2,FBIT↔GO FF
01000 TESTZ Q2,EBIT↔GO FE
01100 TESTZ Q2,VBIT↔GO FV↔GO FALSE
01200 L1: TESTZ Q2,EBIT↔EXCH Q1,Q2
01300 TEST Q1,EBIT↔GO L2 ;POTENTIAL EDGE NOW IN Q1.
01400 TESTZ Q2,EBIT↔GO EE
01500 TESTZ Q2,VBIT↔GO EV↔GO FALSE
01600 L2: TEST Q1,VBIT↔GO FALSE
01700 TEST Q2,VBIT↔GO FALSE↔GO VV
01800
01900 ;FACES WITH COMMON EDGE.
02000 FF: PED E,Q1↔DAC E,E0#
02100 CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
02200 SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO FF+2↔GO FALSE
02300
02400 ;EDGE IN FACE PERIMETER.
02500 FE: PFACE 1,Q2↔CAMN 1,Q1↔GO TRUE
02600 NFACE 1,Q2↔CAMN 1,Q1↔GO TRUE↔GO FALSE
02700
02800 ;VERTEX IN FACE PERIMETER.
02900 FV: PED E,Q2↔DAC E,E0
03000 JUMPE E,[PFACE 1,Q1↔PVT 0,Q2↔CAME 0,1↔GO FALSE↔GO TRUE]
03100 PFACE 1,E↔CAMN 1,Q1↔GO TRUE↔NFACE 1,E↔CAMN 1,Q1↔GO TRUE
03200 SETQ(E,{ECCW,E,Q2})↔CAME E,E0↔GO FV+2↔GO FALSE
03300
03400 ;EDGES WITH A COMMON VERTEX.
03500 EE: PVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
03600 NVT 1,Q2↔CAMN 0,1↔GO TRUE
03700 NVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
03800 NVT 1,Q2↔CAMN 0,1↔GO TRUE↔GO FALSE
03900
04000 ;VERTEX IN EDGE.
04100 EV: PVT 1,Q1↔CAMN 1,Q2↔GO TRUE
04200 NVT 1,Q1↔CAMN 1,Q2↔GO TRUE↔GO FALSE
04300
04400 ;VERTICES WITH A COMMON EDGE.
04500 VV: PED E,Q1↔DAC E,E0
04600 CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
04700 SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO VV+2↔GO FALSE
04800
04900 FALSE: SETZ 1,↔POP2J
05000 TRUE: SETO 1,↔POP2J
05100 LIT↔VAR
05200 BEND;1/13/73------------------------------------------------------
00100 SUBR(ERIGHT)------------------------------------------------------
00200 TDZA 1,1 ;E ← ERIGHT(FROM-V,ABOUT-F).
00300 SUBR(ELEFT)-------------------------------------------------------
00400 SETO 1, ;E ← ELEFT(FROM-V,ABOUT-F).
00500 ; ELEFT ←-------V-------→ ERIGHT
00600 ; | |
00700 ; | F |
00800 ; | |
00900 BEGIN EFETCH
01000 ACCUMULATORS{V,F,E1,E2}
01100 Q←1
01200 SAVAC(5)
01300 DAC Q,QFLAG#↔LAC V,ARG2↔LAC F,ARG1
01400 TEST V,VBIT↔GO[SETCMM QFLAG↔EXCH F,V↔GO .+1]
01500 PED E2,V↔DAC E2,E0#
01600 L1: LAC E1,E2
01700 ;E2←ECW(E1,V) AND Q←FCW(E1,V).
01800 PVT Q,E1↔CAME Q,V↔GO .+4↔NCCW E2,E1↔NFACE Q,E1↔GO .+6
01900 NVT Q,E1↔CAME Q,V↔GO DIE↔PCCW E2,E1↔PFACE Q,E1
02000 CAMN Q,F↔GO L2↔CAME E2,E0↔GO L1
02100 DIE: FATAL(EFETCH)
02200 L2: LAC 1,E1↔SKIPE QFLAG↔LAC 1,E2
02300 GETAC(5)↔POP2J
02400 BEND;1/13/73------------------------------------------------------
00100 ;E←ECW(FROM-X,ABOUT-Y) - EDGE CLOCKWISE FROM X ABOUT Y.
00200 SUBR(ECW)---------------------------------------------------------
00300 BEGIN ECW
00400 Q←1 ↔ X←2 ↔ E←3
00500 CDR 1,ARG2↔TEST 1,EBIT↔GO ERIGHT
00600 DAC 2,AC2↔ DAC 3,AC3
00700 CDR X,ARG1↔LAC E,1
00800 TEST X,VBIT↔GO[
00900 PFACE Q,E↔CAME Q,X↔GO L1↔ PCW Q,E↔GO L
01000 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L]
01100 PVT Q,E↔CAME Q,X↔GO L2↔ NCCW Q,E↔GO L
01200 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ PCCW Q,E↔GO L
01300 DIE: FATAL(ECW)
01400 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
01500 LIT
01600 BEND;1/13/73------------------------------------------------------
01700
01800 SUBR(ECCW)--------------------------------------------------------
01900 BEGIN ECCW
02000 Q←1 ↔ X←2 ↔ E←3
02100 CDR 1,ARG2↔TEST 1,EBIT↔GO ELEFT
02200 DAC 2,AC2↔ DAC 3,AC3
02300 CDR X,ARG1↔LAC E,1
02400 TEST X,VBIT↔GO[
02500 PFACE Q,E↔CAME Q,X↔GO L1↔ PCCW Q,E↔GO L
02600 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCCW Q,E↔GO L]
02700 PVT Q,E↔CAME Q,X↔GO L2↔ PCW Q,E↔GO L
02800 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L
02900 DIE: FATAL(ECCW)
03000 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
03100 LIT
03200 BEND;1/13/73------------------------------------------------------
00100 SUBR(OTHER)-------------------------------------------------------
00200 BEGIN OTHER
00300 Q←1 ↔ X←2 ↔ E←3
00400 DAC 2,AC2↔ DAC 3,AC3
00500 CDR X,ARG1↔CDR E,ARG2
00600 TEST X,VBIT↔GO[
00700 PFACE Q,E↔CAME Q,X↔GO L1↔ NFACE Q,E↔GO L
00800 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ PFACE Q,E↔GO L]
00900 PVT Q,E↔CAME Q,X↔GO L2↔ NVT Q,E↔GO L
01000 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ PVT Q,E↔GO L
01100 DIE: FATAL(OTHER)
01200 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
01300 LIT
01400 BEND;1/13/73------------------------------------------------------
01500
01600 ; OTHER.(Q,E,X)
01700 SUBR(OTHER.)------------------------------------------------------
01800 BEGIN OTHER.
01900 Q←1↔ X←2↔ E←3
02000 DAC AC0↔DAC 1,AC1↔DAC 2,AC2↔DAC 3,AC3
02100 CDR X,ARG1↔ CDR E,ARG2↔ CDR Q,ARG3
02200 TEST X,VBIT↔GO[
02300 PFACE 0,E↔ CAME X↔ GO L1↔ NFACE. Q,E↔GO L
02400 L1: NFACE 0,E↔ CAME X↔ GO DIE↔PFACE. Q,E↔GO L]
02500 NVT 0,E↔ CAME X↔ GO L2↔ PVT. Q,E↔GO L
02600 L2: PVT 0,E↔ CAME X↔ GO DIE↔NVT. Q,E↔GO L
02700 DIE: FATAL(OTHER.)
02800 L: LAC AC0↔LAC 1,AC1↔LAC 2,AC2↔LAC 3,AC3
02900 POP3J↔LIT
03000 BEND;1/13/73------------------------------------------------------
00100 ; BODY FETCHER - GET THE BODY OF Q.
00200 ; B ← BODY(Q).
00300 SUBR(BODY)--------------------------------------------------------
00400 BEGIN BODY
00500 Q←1
00600 CDR Q,ARG1
00700 TESTZ Q,BBIT
00800 POP1J ;Q'S ALREADY A BODY.
00900 TESTZ Q,EBIT
01000 L1: GO [PBODY Q,Q↔POP1J] ;Q WAS AN EDGE.
01100 TESTZ Q,FBIT
01200 GO [PFACE 0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;FACE
01300 TESTZ Q,VBIT
01400 GO [PVT 0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;VERTEX
01500 POP1J; Q AIN'T GOT NO BODY.
01600 L2: LAC 1,0↔POP1J ;VERTEX BODY CASE.
01700 LIT
01800 BEND;1/13/73------------------------------------------------------
01900
00100 ;V ← VCW(E,F).
00200 SUBR(VCW)---------------------------------------------------------
00300 BEGIN VCW
00400 Q←1 ↔ E←2
00500 DAC 2,AC2
00600 CDR E,ARG2
00700 PFACE Q,E↔CAME Q,ARG1↔GO L1 ↔PVT Q,E↔GO L
00800 L1: NFACE Q,E↔CAME Q,ARG1↔GO DIE↔NVT Q,E↔GO L
00900 DIE: FATAL(VCW)
01000 L: LAC 2,AC2↔POP2J↔LIT
01100 BEND;1/13/73------------------------------------------------------
01200
01300 ;V ← VCCW(E,F).
01400 SUBR(VCCW)--------------------------------------------------------
01500 BEGIN VCCW
01600 Q←1 ↔ E←2
01700 DAC 2,AC2
01800 CDR E,ARG2
01900 PFACE Q,E↔CAME Q,ARG1↔GO L1 ↔NVT Q,E↔GO L
02000 L1: NFACE Q,E↔CAME Q,ARG1↔GO DIE↔PVT Q,E↔GO L
02100 DIE: FATAL(VCCW)
02200 L: LAC 2,AC2↔POP2J↔LIT
02300 BEND;1/13/73------------------------------------------------------
02400
02500 ;F ← FCW(E,V).
02600 SUBR(FCW)---------------------------------------------------------
02700 BEGIN FCW
02800 Q←1 ↔ E←2
02900 DAC 2,AC2
03000 CDR E,ARG2
03100 PVT Q,E↔CAME Q,ARG1↔GO L1 ↔NFACE Q,E↔GO L
03200 L1: NVT Q,E↔CAME Q,ARG1↔GO DIE↔PFACE Q,E↔GO L
03300 DIE: FATAL(FCW)
03400 L: LAC 2,AC2↔POP2J↔LIT
03500 BEND;1/13/73------------------------------------------------------
03600
03700 ;F ← FCCW(E,V).
03800 SUBR(FCCW)--------------------------------------------------------
03900 BEGIN FCCW
04000 Q←1 ↔ E←2
04100 DAC 2,AC2
04200 CDR E,ARG2
04300 PVT Q,E↔CAME Q,ARG1↔GO L1 ↔PFACE Q,E↔GO L
04400 L1: NVT Q,E↔CAME Q,ARG1↔GO DIE↔NFACE Q,E↔GO L
04500 DIE: FATAL(FCCW)
04600 L: LAC 2,AC2↔POP2J↔LIT
04700 BEND;1/13/73------------------------------------------------------
00100 SUBR(MKLOCOR)-----------------------------------------------------
00200 BEGIN MKLOCOR
00300 CALL(MAKE,[1.0])
00400 LIPI(<1.0>)
00500 DAC IX(1)
00600 DAC JY(1)
00700 DAC KZ(1)
00800 POP0J
00900 BEND;1/13/73------------------------------------------------------
01000 END
01100 WING.FAI - EOF.